CD Actual 22/PC Actual CD 22.iso/progs/DIRECTOR/data.z/Learning Director.dcr/UtilsCast_3_MS_ListIO.ls

Text File | 1997-05-10 | 10.1 KB | 324 lines

global gListIOfileObjOrString

on getlist fileNameOrTextCast, cstlib
  set propList to getaProp([:], 1)
  set textCastNum to 0
  set textCastLineNum to 1
  set castLibNum to 1
  set fileObj to 0
  if integerp(fileNameOrTextCast) then
    set textCastNum to fileNameOrTextCast
  else
    if char 1 of fileNameOrTextCast = "@" then
      set textCastNum to the number of member chars(fileNameOrTextCast, 2, length(fileNameOrTextCast))
    else
      set fileObj to fileio(mnew, "read", fileNameOrTextCast)
    end if
  end if
  if textCastNum > 0 then
    if the paramCount = 2 then
      set castLibNum to the number of castLib cstlib
    else
      set castLibNum to 1
    end if
  end if
  if objectp(fileObj) or (textCastNum > 0) then
    set MORE to 1
    repeat while MORE
      if objectp(fileObj) then
        set lineString to fileObj(mReadLine)
      else
        set lineString to line textCastLineNum of the text of member textCastNum of castLib castLibNum
        set textCastLineNum to textCastLineNum + 1
      end if
      if lineString = EMPTY then
        set MORE to 0
        next repeat
      end if
      set firstWord to word 1 of lineString
      if firstWord <> EMPTY then
        set lineString to chars(lineString, offset(firstWord, lineString), length(lineString))
        set pos to length(lineString)
        repeat while 1
          set aChar to char pos of lineString
          if (aChar = " ") or (aChar = TAB) or (aChar = RETURN) then
            set pos to pos - 1
            next repeat
          end if
          exit repeat
        end repeat
        set lineString to chars(lineString, 1, pos)
        set fileContents to fileContents & lineString
      end if
    end repeat
    if objectp(fileObj) then
      fileObj(mdispose)
    end if
    set propList to value(fileContents)
  end if
  return propList
end

on ImportTextInto fileName, memNum, castLibNum
  set fileObj to fileio(mnew, "read", fileName)
  if objectp(fileObj) then
    set s to fileObj(mReadFile)
    fileObj(mdispose)
  else
    set s to EMPTY
  end if
  if the paramCount = 3 then
    if stringp(castLibNum) then
      set castLibNum to the number of castLib castLibNum
    end if
  else
    set castLibNum to 1
  end if
  duplicate(member "empty#field", member memNum of castLib castLibNum)
  set the text of member memNum of castLib castLibNum to s
end

on outputLine lineString, fileObjOrString, formatted
  if objectp(fileObjOrString) then
    if formatted then
      set lineString to lineString & RETURN
    end if
    fileObjOrString(mWriteString, lineString)
    if fileObjOrString(mStatus) <> 0 then
      return 0
    end if
  else
    if stringp(fileObjOrString) then
      set gListIOfileObjOrString to gListIOfileObjOrString & lineString
      if formatted then
        set gListIOfileObjOrString to gListIOfileObjOrString & RETURN
      end if
    else
      put lineString
    end if
  end if
  return 1
end

on putlist propList, fileNameOrTextCast, cstlib
  set castLibNum to 1
  set textCastNum to EMPTY
  if (paramCount() > 1) and not symbolp(fileNameOrTextCast) then
    if integerp(fileNameOrTextCast) then
      set textCastNum to fileNameOrTextCast
      set gListIOfileObjOrString to EMPTY
    else
      if char 1 of fileNameOrTextCast = "@" then
        set textCastNum to the number of member chars(fileNameOrTextCast, 2, length(fileNameOrTextCast))
        set gListIOfileObjOrString to EMPTY
      else
        set gListIOfileObjOrString to fileio(mnew, "write", fileNameOrTextCast)
        if objectp(gListIOfileObjOrString) = 0 then
          return 0
        end if
      end if
    end if
  else
    set gListIOfileObjOrString to 0
  end if
  if integerp(textCastNum) then
    if the paramCount >= 2 then
      set castLibNum to the number of castLib cstlib
    else
      set castLibNum to 1
    end if
    if textCastNum < 0 then
      set createTextCast to 1
    else
      if the type of member textCastNum of castLib cstlib = #empty then
        set createTextCast to 1
      else
        set createTextCast to 0
      end if
    end if
  end if
  set formatted to not (param(paramCount()) = #unformatted)
  set listWalker to [0: 0]
  set currList to propList
  set currListPos to 1
  set thisDepth to 0
  set tabString to "    "
  if not outputLine("[", gListIOfileObjOrString, formatted) then
    return 0
  end if
  repeat while listp(currList)
    set lineString to EMPTY
    if formatted then
      repeat with depthCount = 0 to thisDepth
        set lineString to lineString & tabString
      end repeat
    end if
    if currListPos <= count(currList) then
      if ilk(currList, #propList) then
        set prop to getPropAt(currList, currListPos)
        if ilk(prop, #symbol) then
          set lineString to lineString & "#" & string(prop) & " : "
        else
          if ilk(prop, #string) then
            set lineString to lineString & QUOTE & string(prop) & QUOTE & " : "
          else
            set lineString to lineString & string(prop) & " : "
          end if
        end if
      end if
      set isListValue to 0
      set value to getAt(currList, currListPos)
      if ilk(value, #propList) or ilk(value, #linearList) then
        set isListValue to 1
        addProp(listWalker, currList, currListPos + 1)
        set currList to value
        set currListPos to 1
        set thisDepth to thisDepth + 1
        set lineString to lineString & "["
      else
        if ilk(value, #string) then
          if paramCount() > 1 then
            set strLen to length(value)
            set startPos to 1
            repeat with endPos = 1 to strLen
              set c to char endPos of value
              if c = QUOTE then
                set lineString to lineString & QUOTE & chars(value, startPos, endPos - 1) & QUOTE & ""E"
                set startPos to endPos + 1
                if endPos < strLen then
                  set lineString to lineString & "&"
                end if
                next repeat
              end if
              if c = RETURN then
                set lineString to lineString & QUOTE & chars(value, startPos, endPos - 1) & QUOTE & "&RETURN"
                set startPos to endPos + 1
                if endPos < strLen then
                  set lineString to lineString & "&"
                end if
                next repeat
              end if
            end repeat
            if (strLen = 0) or (startPos < endPos) then
              set lineString to lineString & QUOTE & chars(value, startPos, endPos - 1) & QUOTE
            end if
          else
            set lineString to lineString & QUOTE & string(value) & QUOTE
          end if
          set currListPos to currListPos + 1
        else
          if ilk(value, #symbol) then
            set lineString to lineString & "#" & string(value)
            set currListPos to currListPos + 1
          else
            set lineString to lineString & string(value)
            set currListPos to currListPos + 1
          end if
        end if
      end if
      if (currListPos <= count(currList)) and not isListValue then
        set lineString to lineString & ","
      end if
      if not outputLine(lineString, gListIOfileObjOrString, formatted) then
        return 0
      end if
      next repeat
    end if
    if ilk(currList, #propList) then
      if count(currList) = 0 then
        set lineString to lineString & " : "
        if not outputLine(lineString, gListIOfileObjOrString, formatted) then
          return 0
        end if
      end if
    end if
    set currList to getPropAt(listWalker, count(listWalker))
    set currListPos to getAt(listWalker, count(listWalker))
    set thisDepth to thisDepth - 1
    set lineString to EMPTY
    if thisDepth >= 0 then
      deleteAt(listWalker, count(listWalker))
      if formatted then
        repeat with depthCount = 0 to thisDepth
          set lineString to lineString & tabString
        end repeat
      end if
      set lineString to lineString & "]"
      if currListPos <= count(currList) then
        set lineString to lineString & ","
      end if
      if not outputLine(lineString, gListIOfileObjOrString, formatted) then
        return 0
      end if
    end if
  end repeat
  if not outputLine("]", gListIOfileObjOrString, formatted) then
    return 0
  end if
  if objectp(gListIOfileObjOrString) then
    gListIOfileObjOrString(mdispose)
  else
    if stringp(gListIOfileObjOrString) then
      if createTextCast then
        set textCastNum to findEmpty(member 1 of castLib castLibNum)
        duplicate(member "empty#field", member textCastNum of castLib castLibNum)
        set the name of member textCastNum of castLib castLibNum to chars(fileNameOrTextCast, 2, length(fileNameOrTextCast))
      end if
      set the text of member textCastNum of castLib castLibNum to gListIOfileObjOrString
      set gListIOfileObjOrString to 0
    end if
  end if
  return 1
end

on FindPropList propList, listName
  set listWalker to [0: 0]
  set currList to propList
  set currListPos to 1
  set linearSearch to 0
  repeat while currList <> 0
    if currListPos <= count(currList) then
      set match to 0
      if linearSearch = 0 then
        set currListPos to findPos(currList, listName)
        if currListPos >= 1 then
          set match to 1
        else
          set currListPos to 1
        end if
      else
        set keyString to getPropAt(currList, currListPos)
        if keyString = listName then
          set match to 1
        end if
      end if
      set value to getAt(currList, currListPos)
      if match = 1 then
        if ilk(value, #propList) then
          return value
        else
          set currListPos to currListPos + 1
          set linearSearch to 1
        end if
      else
        if ilk(value, #propList) then
          addProp(listWalker, currList, currListPos + 1)
          set currList to getAt(currList, currListPos)
          set currListPos to 1
          set linearSearch to 0
        else
          set currListPos to currListPos + 1
          set linearSearch to 1
        end if
      end if
      next repeat
    end if
    set currList to getPropAt(listWalker, count(listWalker))
    set currListPos to getAt(listWalker, count(listWalker))
    if currList <> 0 then
      deleteAt(listWalker, count(listWalker))
    end if
  end repeat
  return 0
end